home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / UTILITY1 / MSWLGO35.ZIP / LOGOLIB / DEMO < prev    next >
Text File  |  1993-10-13  |  10KB  |  404 lines

  1. to demo
  2. messagebox "Demo [Welome to MswLogo Demonstration]
  3. messagebox "Demo [MswLogo can do Fonts, at any angle (in Windows 3.1) and any color]
  4. cs
  5. setbitmode 1
  6. setpensize [1 1]
  7. setpencolor [0 0 0]
  8. pennormal
  9. ht
  10. pu
  11. ifelse equalp first bf machine 31 ~
  12. [settextfont[[Times New Roman] 50 400 0 0 0]] ~
  13. [settextfont[[System] 50 400 0 0 0]]
  14. repeat 36 [fd 175 setpencolor (list 0 repcount*8 0) label heading bk 175 rt 10]
  15. pd
  16. messagebox "Demo [MswLogo can do Flood Fills]
  17. cs 
  18. repeat 18 [pu fd 100 pd repeat 4 [fd 50 rt 90] rt 45 pu fd 5 setfloodcolor (list repcount*15 0 0) fill bk 5 lt 45 bk 100 rt 20]
  19. pd
  20. messagebox "Demo [MswLogo can use the full range of colors]
  21. cs 
  22. setpensize [2 2]
  23. clearpalette
  24. repeat 72 [repeat 4 [fd 100 rt 90] setpencolor (list repcount*3 0 0) rt 5]
  25. pu
  26. messagebox "Demo [MswLogo can cut Bitmaps]
  27. setxy -50 -50
  28. bitcut 100 100
  29. messagebox "Demo [MswLogo can paste Bitmaps]
  30. cs
  31. pu
  32. repeat 36 [fd 150 bitpaste bk 150 rt 10]
  33. messagebox "Demo [MswLogo can even control what you normally control]
  34. repeat 10 [scrollx 10]
  35. repeat 10 [scrolly 10]
  36. repeat 10 [scrollx -10]
  37. repeat 10 [scrolly -10]
  38. messagebox "Demo [MswLogo can paste images in many ways]
  39. clearpalette
  40. cs
  41. pu
  42. repeat 9 [setfloodcolor (list repcount*25 repcount*25 repcount*25) bitblock 50 5 fd 5]
  43. messagebox "Demo [This image will be pasted onto a Neutral background 9 ways]
  44. setxy 0 0
  45. bitcut 50 50
  46. rt 90
  47. setfloodcolor [125 125 125]
  48. setxy -250 -50
  49. bitblock 550 150
  50. setxy -200 0
  51. repeat 9 [setbitmode repcount bitpaste fd 50]
  52. messagebox "Demo [You can find out what MswLogo is up to at any time]
  53. status
  54. cs
  55. pd
  56. setpensize [1 1]
  57. rose 150 30 [pu  setx xcor + 5  pd]
  58. messagebox "Demo [MswLogo can solve complex problems with your help]
  59. nostatus
  60. cs
  61. hanoi 3
  62. pd
  63. messagebox "Demo [MswLogo can make all the sounds you like]
  64. cs
  65. repeat 50 [sound (list repcount*10 100)]
  66. messagebox "Demo [MswLogo can even do more than one thing at a time Note that the tone you will here is a timer executing code while the picture is being drawn]
  67. cs
  68. settimer 1 1000 [sound [1000 40]]
  69. penpaint
  70. spiral 91 2 10 100
  71. messagebox "Demo [MswLogo can even write Windows programs]
  72. cs
  73. cleartimer 1
  74. win
  75. messagebox "Demo [End of Demonstration and the Start of your imagination]
  76. end
  77.  
  78. to rose :size :petalcount :function
  79. make "ctr 0
  80. do.while ~
  81.    [ ~
  82.    line :size ~
  83.    rt 360 / :petalcount ~
  84.    make "ctr :ctr + 1 ~
  85.    run :function ~
  86.    ] ~
  87.    [:ctr < :petalcount]
  88. end
  89.  
  90. to line :length
  91. fd :length / 2
  92. pu
  93. bk :length
  94. pd
  95. fd :length / 2
  96. end
  97.  
  98. to hanoi :number 
  99. ;
  100. ; Towers of Hanoi
  101. ; Meyer A. Billmers
  102. ; November, 1983
  103. ;
  104. ; This procedure plays a graphic version of the Towers of Hanoi puzzle
  105. ; The argument is the number of disks in the configuration.
  106. ;
  107. ; c.f. putdisk, towercnt,towerset, hanoihlpr
  108. local "from
  109. local "to
  110. local "other
  111. local "datfil
  112. ;make "datfil openw "hanoi.dat
  113. ;fileprint :datfil (sentence [Hanoi of ] :number [towers Started at: ] time)
  114. ; to change the starting and ending needles, change the next three assignments
  115. make "from 1
  116. make "to 3
  117. make "other 2
  118. cs
  119. ht
  120. penpaint
  121. setpensize [5 5]
  122. ; first we draw the table and the golden needles
  123. setpencolor [255 0 0]
  124. pu
  125. setxy -350 -100
  126. pd
  127. setxy 350 -100
  128. pu
  129. setx -240
  130. pd
  131. fd 250
  132. pu
  133. setxy -15 -100
  134. pd
  135. fd 250
  136. pu
  137. setxy 210 -100
  138. pd
  139. fd 250
  140. make "tower1 0
  141. make "tower2 0
  142. make "tower3 0
  143. ; draw the initial stack of disks. note that putdisk draws the 
  144. ; "fixed up" towers.
  145. repeat :number ~
  146.    [~
  147.    putdisk :from :number - repcount + 1 "final ~
  148.    ifelse :from = 1 ~
  149.       [make "tower1 :tower1 + 1] ~
  150.       [ifelse :from = 2 ~
  151.          [make "tower2 :tower2 + 1] ~
  152.          [make "tower3 :tower3 + 1] ~
  153.       ] ~
  154.    ]
  155. hanoihlpr :number :from :to :other
  156. ; fileprint :datfil (sentence [Hanoi Ended at: ] time)
  157. ; close :datfil
  158. end
  159.  
  160. to hanoihlpr :number :from :to :other
  161. ;
  162. ; Called by HANOI. Contains the actual recursive Towers of Hanoi algorithm
  163. ;
  164. local "tcf 
  165. local "tct
  166. if equalp :number 0 [stop]
  167. hanoihlpr :number-1 :from :other :to
  168. make "tcf towercnt :from
  169. make "tct towercnt :to
  170. towerset :from :tcf - 1
  171. putdisk :from :number "temp
  172. putdisk :to :number "temp
  173. putdisk :from :number "erase
  174. putdisk :to :number "final
  175. towerset :to :tct + 1
  176. hanoihlpr :number-1 :other :to :from
  177. end
  178.  
  179. to putdisk :tnum :dnum :state
  180. ;
  181. ; Called by HANOI to put a disk on a tower.
  182. ; first arg. is number of tower (1,2 or 3)
  183. ; second arg. is number of disk to draw (1 is smallest)
  184. ; third arg. is "final, "temp, or "erase depending on whether
  185. ;   disk is drawn in final state, in temporary state to indicate
  186. ;   motion, or is being erased (removed from this tower)
  187. ; Note that this procedure re-draws the tower correctly.
  188. ;
  189. local "tc
  190. local "halfsize
  191. make "tc towercnt :tnum
  192. make "halfsize sum 20 product :dnum 10
  193. pu
  194. ifelse :tnum = 1 ~
  195.    [setxy "-240 "-100] ~
  196.    [ ~
  197.    ifelse :tnum = 2 ~
  198.       [setxy "-15 "-100] ~
  199.       [setxy 210 "-100] ~
  200.    ]
  201. pe
  202. fd product 30 :tc
  203. pu
  204. setxy xcor - :halfsize ycor
  205. pd
  206. penpaint
  207. ifelse :state = "final ~
  208.    [setpencolor [0 255 0]] ~
  209.    [ ~
  210.    ifelse :state = "temp ~
  211.       [setpencolor [0 0 255]] ~
  212.       [pe] ~
  213.    ]
  214. fd 30
  215. rt 90
  216. fd product :halfsize 2
  217. rt 90
  218. fd 30
  219. rt 90
  220. pu
  221. fd :halfsize
  222. rt 90
  223. setpencolor [255 0 0]
  224. ifelse :state = "erase ~
  225.    [ ~
  226.    pd ~
  227.    penpaint ~
  228.    fd 30 ~
  229.    ] ~
  230.    [ ~
  231.    pe ~
  232.    fd 30 ~
  233.    ]
  234. end
  235.  
  236. to towercnt :tn
  237. ;
  238. ; Called by HANOI. Returns the current number of disks on tower :tn,
  239. ; as stored in the globals tower1, tower2, and tower3.
  240. ;
  241. ifelse :tn = 1 ~
  242.    [output :tower1] ~
  243.    [ ~
  244.    ifelse :tn = 2 ~
  245.       [output :tower2] ~
  246.       [output :tower3] ~
  247.    ]
  248. end
  249.  
  250. to towerset :tn :value
  251. ;
  252. ; Called by HANOI. Sets the current number of disks on tower :tn,
  253. ; as stored in the globals tower1, tower2, and tower3.
  254. ;
  255. ifelse :tn = 1 ~
  256.    [make "tower1 :value] ~
  257.    [ ~
  258.    ifelse :tn = 2 ~
  259.       [make "tower2 :value] ~
  260.       [make "tower3 :value] ~
  261.    ]
  262. end
  263.  
  264. to spiral :angle :repeat :incr :segs
  265. ;; 
  266. ;; Spirals, by Meyer A. Billmers
  267. ;;  
  268. ;; This procedure makes pretty spirals. I suggest you first do a 
  269. ;; hideturtle so the drawing will proceed at a reasonable rate.
  270. ;; 
  271. ;; angle   is the amount of turn at each piece, 
  272. ;; repeat  is the number of turns before the distance is incremented, and
  273. ;; incr    is the amount of distance increment.
  274. ;; 
  275. ;; Suggested fun spirals:
  276. ;;     spiral 90 2 10
  277. ;;     spiral 91 2 10
  278. ;;     spiral 60 3 10
  279. ;;     spiral 61 3 10
  280. ;;     spiral 179 2 5
  281. ;;     spiral 20 10 4
  282. ;; 
  283. make "len :incr
  284. make "ctr 0
  285. repeat :segs ~
  286.   [ ~
  287.   fd :len ~
  288.   rt :angle ~
  289.   make "ctr :ctr + 1 ~
  290.   if :ctr = :repeat ~
  291.      [ ~
  292.      make "ctr 0 ~
  293.      make "len :len + :incr ~
  294.      ] ~
  295.   ]
  296. end
  297.  
  298. to win
  299. make "cmw 75
  300. make "cmh 30
  301. make "sth 12
  302. make "lsw :cmw
  303. make "lsh 20
  304. make "scw 10
  305. make "sch 40
  306. make "btw 50
  307. make "bth 12
  308. make "gapx 6
  309. make "gapy 6
  310. make "mary 2
  311. make "wnx 180
  312. make "wny 120
  313. make "wnx2 :wnx / 2
  314. make "wny2 :wny / 2
  315. make "wnx3 :wnx / 3
  316. make "wny3 :wny / 3
  317. make "wnx6 :wnx / 6
  318. make "wny6 :wny / 6
  319. make "st2w 30
  320. make "row2 :wny3+:gapy
  321. make "row3 :wny3*2-:gapy/2
  322.  
  323. windowcreate "main "d1 [This is a Demo Windows Application] 0 0 :wnx+:gapy :wny+:gapy
  324.  
  325. staticcreate "d1 "st2 [Run mode] :gapx :mary :cmw :sth
  326. groupboxcreate "d1 "g1 :gapx :sth+:mary :cmw :cmh
  327. checkboxcreate "d1 "g1 "cb1 [Hide Turtle] :gapx+:gapx :sth+:mary+:gapy :btw :bth
  328. checkboxcreate "d1 "g1 "cb2 [Status]      :gapx+:gapx :sth+:mary+:bth+4 :btw :bth
  329.  
  330. staticcreate "d1 "st3 [Select Post-Command] :wnx2+:gapx :mary :cmw :sth
  331. comboboxcreate "d1 "c2 :wnx2+:gapx :sth+:mary :cmw :cmh
  332. comboboxaddstring "c2 [RT 2]
  333. comboboxaddstring "c2 [RT 5]
  334. comboboxaddstring "c2 [RT 10]
  335. comboboxsettext "c2 [RT 5]
  336.  
  337. staticcreate "d1 "st4 [Select Shape] :gapx :row2 :lsw :sth
  338. listboxcreate "d1 "l1 :gapx :row2+:sth+1 :lsw :lsh
  339. listboxaddstring "l1 "SQUARE
  340. listboxaddstring "l1 "TRIANGLE
  341. listboxaddstring "l1 "HEXAGON
  342.  
  343. staticcreate "d1 "st11 "Red :wnx6*3+:gapx :row2 :st2w :sth
  344. scrollbarcreate "d1 "s1 :wnx6*3+:gapx :row2+:sth :scw :sch [myred]
  345. scrollbarset "s1 1 255 125 myred
  346.  
  347. staticc